/*
 *	Plurals
 *
 *	Author:	S.C.Merrall
 *
 *	File:		mp_vector.m
 *
 *	Contents:	make_vector
 *			vector_ref
 *			vector_set
 *			vector_length
 *                      vector_merge
 *
 *	Description:	Functions for creating and accessing the contents
 *			of vectors
 *
 *	Change History:
 *
 *	Date   Name Comment
 *    -------- ---- -------
 *    15:05:91 SCM  Created
 *
 */

#include <mpl.h>
#include <stdio.h>

#include "constant.h"

#include "mp_object.h"
#include "mp_debug.h"
#include "mp_type.h"
#include "mp_gc.h"

/*----------------------------------------------------------------------------*
 * Function   : make_vector
 *
 * Parameters : MP_PluralHeap MPPH_length:	Size of vector
 *		MP_PluralHeap MPPH_vector:	Resulting vectors
 *
 * Description: Allocate a vector of 'length' elements, each element is 
 *		initially set to nil
 *
 * Result     : int:	SUCESS/FAIL
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int make_vector( MP_PluralHeap MPPH_length, MP_PluralHeap MPPH_vector )

#else

int make_vector( MPPH_length, MPPH_vector )

MP_PluralHeap MPPH_length;
MP_PluralHeap MPPH_vector;

#endif

{
  plural natural *plural new_vector;
  plural int length;
  plural int i;
DBG_CALL("make_vector");
DBG_ARGS(fprintf(dbg,"length=????, MPPH_vector=%04x",MPPH_vector));

  /* Check all the lengths are integers */

  if (globalor(OA_info(MPPH_length) != INTEGER)) {

DBG_FAIL(fprintf(dbg,"FAIL: Not all the lengths are integers"));
    return FAIL;
  }
  length = *(plural int *plural) OA_data(MPPH_length);

  /* Allocate space for new vectors */

  if (mp_alloc((plural int) MP_VECTOR, length, MPPH_vector) == FAIL) {

DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space")); 
    return FAIL;
  }

  new_vector = (plural natural *plural) OA_data(MPPH_vector);

  for (i=0; i < length; i++) {            /* Initialise all elements to NIL */

    *(new_vector + i) = NIL;
  }

DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : vector_set
 *
 * Parameters : MP_PluralHeap MPPH_vector:	MasPar Plural Heap object, 
 *						handle on the vectors 
 *		MP_PluralHeap MPPH_index:	Index of the vector which is 
 *						to be updated.
 *		MP_PluralHeap MPPH_value:	MasPar Plural Heap object, 
 *						handle on Heap space of new 
 *						value at that index.
 *
 * Description:    Sets the indexth element of the vector MPPH_vector to
 *		be MPPH_value. Note that each element of MPPH_value can be
 *		a different object and that each elemnt of index can have
 *		a different value. These are full parallel versions!
 *
 * Result     : int:	SUCCESS/FAIL
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int vector_set( MP_PluralHeap MPPH_vector, MP_PluralHeap index, 
		MP_PluralHeap MPPH_value )

#else

int vector_set( MPPH_vector, MPPH_index, MPPH_value )

MP_PluralHeap MPPH_vector;
MP_PluralHeap MPPH_index;
MP_PluralHeap MPPH_value; 

#endif

{
  plural natural *plural vector;
  plural int index;
DBG_CALL("vector_set");
DBG_ARGS(fprintf(dbg,"MPPH_vector=????, MPPH_index=????, MPPH_value=????"));

  /* Check these are all vectors */

  if (globalor(OA_info(MPPH_vector) != MP_VECTOR)) {

DBG_FAIL(fprintf(dbg,"FAIL: Not all these are vectors"));
    return FAIL;
  }

  /* Check index is an integer and within the range of all the vectors */

  if (globalor(OA_info(MPPH_index) != INTEGER)) {

DBG_FAIL(fprintf(dbg,"FAIL: Not all the indexes are integers"));
    return FAIL;
  }

  index = *(plural int *plural) OA_data(MPPH_index);

  if (globalor((MP_LENGTH(OA_space(MPPH_vector)) <= index) ||
               (index < 0))) {

DBG_FAIL(fprintf(dbg,"FAIL: index is too large for some of the vectors"));
    return FAIL;
  }

  vector = (plural natural *plural) OA_data(MPPH_vector);
  *(vector + index) = OA_offsets(MPPH_value);

DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : vector_ref
 *
 * Parameters : MP_PluralHeap MPPH_vector:	MasPar Plural Heap object, 
 *						handle on the vectors 
 *		MP_PluralHeap index:		Index of the vector which is 
 *						to be updated.
 *		MP_PluralHeap MPPH_result:	MasPar Plural Heap object, 
 *						handle on indexth objects
 *
 * Description:    Refs the indexth element of the vector MPPH_vector into
 *		 MPPH_value. 
 *
 * Result     : int:	SUCCESS/FAIL
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int vector_ref( MP_PluralHeap MPPH_vector, MP_PluralHeap MPPH_index, 
		MP_PluralHeap MPPH_result )

#else

int vector_ref( MPPH_vector, MPPH_index, MPPH_result )

MP_PluralHeap MPPH_vector;
MP_PluralHeap MPPH_index;
MP_PluralHeap MPPH_result; 

#endif

{
  plural natural *plural vector;
  plural int index;
DBG_CALL("vector_ref");
DBG_ARGS(fprintf(dbg,"MPPH_vector=????, index=????, MPPH_result=????"));

  /* Check these are all vectors */

  if (globalor(OA_info(MPPH_vector) != MP_VECTOR)) {

DBG_FAIL(fprintf(dbg,"FAIL: Not all these are vectors"));
    return FAIL;
  }

  /* Check index is an integer and within the range of all the vectors */

  if (globalor(OA_info(MPPH_index) != INTEGER)) {

DBG_FAIL(fprintf(dbg,"FAIL: Not all the indexes are inetegers"));
    return FAIL;
  }

  index = *(plural int *plural) OA_data(MPPH_index);

  if (globalor((MP_LENGTH(OA_space(MPPH_vector)) <= index) ||
	       (index < 0))) {

DBG_FAIL(fprintf(dbg,"FAIL: index out of some of the vectors range"));
    return FAIL;
  }

  vector = (plural natural *plural) OA_data(MPPH_vector);
  OA_offsets(MPPH_result) = *(vector + index);

DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : vector_length
 *
 * Parameters : MP_PluralHeap MPPH_vector:	Handles on the vectors heap
 *						space and
 *		MP_PluralHeap MPPH_result:	where the lengths are to go
 *
 * Description: Extracts and returns the integer length of each of the 
 *		vectors
 *
 * Result     : int:	FAIL/SUCCESS
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int vector_length( MP_PluralHeap MPPH_vector, MP_PluralHeap MPPH_result )

#else

int vector_length( MPPH_vector, MPPH_result )

MP_PluralHeap MPPH_vector;
MP_PluralHeap MPPH_result;

#endif
     
{
  plural int *plural length;
DBG_CALL("vector_length");
DBG_ARGS(fprintf(dbg,"MPPH_vector=????, MPPH_result=????"));

  /* Check these are all vectors */

  if (OA_info(MPPH_vector) != MP_VECTOR) {

DBG_FAIL(fprintf(dbg,"FAIL: Not all od these are vectors"));
    return FAIL;
  }

  /* Allocate space for the length to go in */

  if (mp_alloc((plural int) INTEGER, (plural int) 1, MPPH_result) == FAIL) {

DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space for the lengths"));
    return FAIL;
  }

  length = (plural int *plural) OA_data(MPPH_result);

  *length = MP_LENGTH(OA_space(MPPH_vector));

DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}
  

 /* Experimental hacks for new processor management mechanism which */
 /* supports overloading of processors at the back end instruction  */
 /* level */

/*----------------------------------------------------------------------------*
 * Function   : vector_merge
 *
 * Parameters : MP_PluralHeap MPPH_set1:	Handles on the keys and
 *		MP_PluralHeap MPPH_set21:	data vectors which are 
 *		MP_PluralHeap MPPH_result:	to be merge sorted
 *
 * Description: This function is a bit of hack but I think is justified.
 *		We merge sort the two key vectors, at the same time we do
 *		identical operations on the two data vectors, this will 
 * 		allow us to join sets of (virtual) processors and their 
 *		values efficiently.
 *
 * Result     : int FAIL/SUCCESS
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int vector_merge( MP_PluralHeap MPPH_set1, MP_PluralHeap MPPH_set2,
		  MP_PluralHeap MPPH_result )

#else

int vector_merge( MPPH_set1, MPPH_set2, MPPH_result )

MP_PluralHeap MPPH_set1;
MP_PluralHeap MPPH_set2;
MP_PluralHeap MPPH_result;

#endif

{
  plural natural *plural key1;
  plural natural *plural key2;
  plural natural *plural to = (plural natural *plural) scratch;
  plural natural *plural from1;
  plural natural *plural from2;
  plural natural *plural data1, *plural data2;
  plural natural *plural last1;
  plural natural *plural last2;
  plural int val1, val2;
  int to_data_offset;
DBG_CALL("vector_merge");
DBG_ARGS(DBG_PARG("MPPH_set1","%x ",MPPH_set1);DBG_PARG("MPPH_set2","%x ",MPPH_set2);DBG_PARG("MPPH_result","%x ",MPPH_result));

  to_data_offset = SCRATCH_MEMORY_SIZE/(2*sizeof(natural));

  /* We are expecting a cons cell of key vector and data vector, so we */
  /* take the  car (in a hackery way) to get the key. */

  key1 = (plural natural *plural) OA_data(MPPH_set1);
  key2 = (plural natural *plural) OA_data(MPPH_set2);

  from1 = (plural natural *plural) OA_data(key1);
  from2 = (plural natural *plural) OA_data(key2);

  last1 = from1 + MP_LENGTH(OA_space(key1));
  last2 = from2 + MP_LENGTH(OA_space(key2));

  data1 = (plural natural *plural) OA_data((plural natural *plural) (OA_data(MPPH_set1) + sizeof(natural)));
  data2 = (plural natural *plural) OA_data((plural natural *plural) (OA_data(MPPH_set2) + sizeof(natural)));

  while ((from1 < last1) || (from2 < last2)) {

    val1 = * (plural int *plural) OA_data( (plural natural *plural) (OA_data(from1) +2));
    val2 = * (plural int *plural) OA_data( (plural natural *plural) (OA_data(from2) + 2));

/*    val1 = * (plural int *plural) OA_data(from1);
    val2 = * (plural int *plural) OA_data(from2);*/

DEBUG(DBG_PARG("val1"," %d",val1));
DEBUG(DBG_PARG("val2"," %d",val2));

    if (val1 == val2) {

      *to = *(from1++);
      from2++;
      *(to + to_data_offset) = *(data1++);
      data2++;
    }
    else if (val1 < val2) {

      *to = *(from1++);
      *(to + to_data_offset) = *(data1++);
    }      
    else {

      *to = *(from2++);
      *(to + to_data_offset) = *(data2++);
    }
    to++;

    if (from1 >= last1) {

      pp_memcpy((plural char *plural) to,
		(plural char *plural) from2, 
		(plural char *plural) last2 - (plural char *plural) from2);
      pp_memcpy((plural char *plural) (to + to_data_offset),
		(plural char *plural) data2, 
		(plural char *plural) last2 - (plural char *plural) from2);
      to = to + (last2 - from2);
      from2 = last2;
    }
    else if (from2 >= last2) {

      pp_memcpy((plural char *plural) to,
		(plural char *plural) from1, 
		((plural char *plural) last1 - (plural char *plural) from1));
      pp_memcpy((plural char *plural) (to + to_data_offset),
		(plural char *plural) data1, 
		((plural char *plural) last1 - (plural char *plural) from1));
      to = to + (last1 - from1);
      from1 = last1;
    }
  }

  if (mp_alloc((plural int) MP_CONS, (plural int) 1, MPPH_result) == FAIL) {

DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate cons for merge "));    
    return FAIL;
  }
  if (mp_alloc((plural int) MP_VECTOR, to - (plural natural *plural) scratch,
	       (plural natural *plural) OA_data(MPPH_result)) == FAIL) {

DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate vector for merge key"));
    return FAIL;
  }
  if (mp_alloc((plural int) MP_VECTOR, to - (plural natural *plural) scratch,
	       ((plural natural *plural) OA_data(MPPH_result)) +1) == FAIL) {

DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate vector for merge data"));
    return FAIL;
  }

  pp_memcpy(OA_data((plural natural *plural) OA_data(MPPH_result)),
	    (plural natural *plural) scratch,
	    ((plural char *plural) to) - scratch);
  pp_memcpy(OA_data((plural natural *plural) (OA_data(MPPH_result) + sizeof(natural))),
	    ((plural char *plural) scratch) +(to_data_offset*sizeof(natural)),
	   ((plural char *plural) to) - scratch);

DBG_EXIT(fprintf(dbg,"SUCCESS"));

  return SUCCESS;
}

